home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / (A)TA / (A)TAR.ADF / Cribbage / cribba.arc / init.bas < prev    next >
BASIC Source File  |  1986-12-06  |  25KB  |  715 lines
  1. 1     rem ** written by David Addison -- (503)-645-6985 -- c1985 -- this program has been put into the public domain -- use kickstart 1.0
  2. 2     clr:screen 0,5:graphic 1:drawmode 0
  3. 3     dim cribscreen%(10000),regsave%(100),clubs%(450),spades%(450),hearts%(450),diamonds%(450),clubs2%(450),spades2%(450),hearts2%(450),diamonds2%(450)
  4. 4     dim back1%(450),back2%(450),computer%(60),human%(60),computerb%(60),humanb%(60),mycrib%(350),yourcrib%(350)
  5. 5     dim points%(350),pointer%(60),pointerb%(60),updown%(300),updownb%(300),backerase%(220),carderase%(360)
  6. 6     dim gobox%(125),goboxb%(125),donebox%(150),doneboxb%(150),winner%(3500)
  7. 7     dim pegpos(121),w(6,4),m(6,4),j(52),v(15,7),i(52),d(52,4),y(6,5),c(4,4),d$(6),q(11,6),r(4,5),s(4),card(6):humcolor=20:compcolor=0
  8. 10    bload "cribscreen_dat",varptr(regsave%(0)):n=0
  9. 12    i%=0
  10. 13    rgb i%,regsave%(n),regsave%(n+1),regsave%(n+2)
  11. 14    n=n+3
  12. 15    i%=i%+1:if i%<32 then 13
  13. 17    pena 6:? at(5,5*8);"Please STANDBY while I set things up."
  14. 20    gosub 32000
  15. 50    dim sinewave%(11):restore 60:for cx%=0 to 11:read sinewave%(cx%):next cx%
  16. 60    data 100,90,60,100,90,60,-100,90,-60,-100,-90,-60
  17. 62    audio 15,1:wave 6,sinewave%
  18. 100   nl$="A23456789TJQK"
  19. 105   me=0:you=0
  20. 110   gosub 30000:gosub 32200
  21. 112   gosub 17000:msg$=" Use MOUSE for all player INPUT !":pena 18:gosub 7010:sleep(2*10^6)
  22. 113   gosub 12000
  23. 135   restore 10000
  24. 140   for n=1 to 15:for m=1 to 7:read v(n,m):next m:next n
  25. 150   for n=1 to 11:for m=1 to 6:read q(n,m):next m:next n
  26. 160   for n=1 to 4:for m=1 to 5:read r(n,m):next m:next n
  27. 170   n=1
  28. 172   read s(n)
  29. 175   n=n+1:if n<5 then 172
  30. 180   n=1
  31. 182   read d$(n)
  32. 185   n=n+1:if n<7 then 182
  33. 300   s1=0:s2=0
  34. 320   gosub 5660:gosub 5820:cut=1
  35. 350   if cut=1 then cut=0:goto 360
  36. 355   gosub 5660
  37. 360   gosub 6100
  38. 380   gosub 3400
  39. 400   i1=v(b9,5):i2=v(b9,6)
  40. 420   gosub 17000:msg$="YOUR DISCARDS? (CHOOSE 2 CARDS)":pena humcolor:gosub 7010
  41. 430   right=6:gosub 25000:i3=q1:i4=q2
  42. 525   y(i3,5)=0:y(i4,5)=0
  43. 530   gosub 23000:cnt=4:gosub 32600
  44. 535   cnt2=27:gosub 22000:cx=8:cy=119
  45. 537   n=1
  46. 540   if y(n,5)=0 then 550
  47. 542   num=y(n,4):suit=y(n,3):gosub 21000
  48. 545   cx=cx+35
  49. 550   n=n+1:if n<7 then 540
  50. 560   j=1
  51. 570   c(1,j)=m(i1,j):c(2,j)=m(i2,j):c(3,j)=y(i3,j):c(4,j)=y(i4,j)
  52. 572   j=j+1:if j<5 then 570
  53. 575   for k=1 to 3
  54. 576   for l=k+1 to 4
  55. 577   if c(k,4)>c(l,4) then 581
  56. 578   for i=1 to 4
  57. 579   swap c(k,i),c(l,i)
  58. 580   next i
  59. 581   next l:next k
  60. 630   gosub 4200
  61. 650   gosub 1490
  62. 670   gosub 24000
  63. 675   if m=0 then 710
  64. 680   gosub 17000:msg$="[ YOU SCORE FIRST ]":pena humcolor:gosub 7010:gosub 8010:x1=1:goto 930
  65. 710   gosub 17000:msg$="[ I SCORE FIRST ]":pena compcolor:gosub 7010:gosub 8010:x1=2:goto 1200
  66. 740   gosub 17000:msg$="- - the crib contains - -":pena 29:gosub 7010
  67. 745   gosub 22000:cx=8:cy=119:j=0
  68. 750   n=1
  69. 765   num=c(n,4):suit=c(n,3):gosub 21000
  70. 770   cx=cx+35
  71. 775   n=n+1:if n<5 then 765
  72. 780   q1=0:for i=1 to 4
  73. 790   for j=1 to 4
  74. 800   w(i,j)=c(i,j)
  75. 810   next j:next i
  76. 830   c=1:w(5,4)=t9
  77. 850   gosub 4420
  78. 860   on x1 goto 870,910
  79. 870   gosub 17000:pena 18:? at(2*8,175);"The crib has  ";p;"  points.  ";
  80. 880   r=p:if r<>0 then gosub 9010
  81. 881   pena 29:? at(12*8,183);inverse (1) "PRESS":? at(18*8,183); "button to continue."
  82. 882   ask mouse x%,y%,b%:if b%<>4 then 882
  83. 900   goto 1370
  84. 910   x1=3
  85. 920   goto 1050
  86. 930   k=1
  87. 940   i=1
  88. 950   if i=i3 then 1000
  89. 960   if i=i4 then 1000
  90. 970   for j=1 to 4
  91. 980   w(k,j)=y(i,j)
  92. 990   next j
  93. 991   k=k+1
  94. 1000  i=i+1:if i<7 then 950
  95. 1010  q1=0:gosub 17000:msg$="..... YOUR CARDS .....":pena humcolor:gosub 7010
  96. 1011  cnt2=17:gosub 22000:cx=8:cy=119
  97. 1012  n=1
  98. 1013  if n=i3 or n=i4 then 1016
  99. 1014  num=y(n,4):suit=y(n,3):gosub 21000
  100. 1015  cx=cx+35
  101. 1016  n=n+1:if n<7 then 1013
  102. 1020  w(5,4)=t9:c=0
  103. 1040  gosub 4420
  104. 1050  if c=0 then gosub 17000:pena 18:msg$="How many points do you have?":gosub 7010
  105. 1055  if c=1 then gosub 17000:pena 18:msg$="How many points are in the crib?":gosub 7010
  106. 1060  gosub 27000
  107. 1070  d=p-p9
  108. 1080  if d>=0 then 1110
  109. 1090  gosub 17000:msg$="Not with that hand. TRY AGAIN !":pena 3:gosub 7010:gosub 8010
  110. 1100  goto 1050
  111. 1110  r=p9:if r<>0 then gosub 9040
  112. 1140  if d=0 then 1190
  113. 1150  gosub 17000:pena 25:? at(5*8,175);inverse(1) " MUGGINS ":? at(14*8,175);" for  ";d;"  points.";
  114. 1170  r=d:gosub 9010
  115. 1171  pena 29:? at(12*8,183);inverse(1) "PRESS":? at(18*8,183);"button to continue."
  116. 1172  ask mouse x%,y%,b%:if b%<>4 then 1172
  117. 1190  on x1 goto 1200,740,1370
  118. 1200  for k=1 to 4
  119. 1210  l=v(b9,k)
  120. 1220  for j=1 to 4
  121. 1230  w(k,j)=m(l,j)
  122. 1240  next j:next k
  123. 1260  for k=1 to 4:l=w(k,1):next k
  124. 1280  gosub 17000:msg$="..... MY CARDS .....":pena compcolor:gosub 7010
  125. 1281  cnt2=17:gosub 22000:cx=8:cy=119
  126. 1282  n=1
  127. 1284  num=w(n,4):suit=w(n,3):gosub 21000
  128. 1285  cx=cx+35
  129. 1286  n=n+1:if n<5 then 1284
  130. 1290  w(5,4)=t9:c=0:gosub 4390
  131. 1320  gosub 17000:pena compcolor:? at(5*8,175);"I have  ";p;"  points.";
  132. 1340  r=p:if r<>0 then gosub 9010
  133. 1341  pena 29:? at(12*8,183);inverse(1) "PRESS":? at(18*8,183);"button to continue."
  134. 1342  ask mouse x%,y%,b%:if b%<>4 then 1342
  135. 1360  on x1 goto 740,930
  136. 1370  gosub 6390
  137. 1380  gosub 22000:for i=100 to 116:draw(50,i to 134,i),0:next i:cxx=9:cyy=63:gosub 32700:goto 350
  138. 1400  gosub 17000
  139. 1410  gshape(46,63),winner%():pena compcolor:? at(92,81);"I WIN THIS GAME":goto 1460
  140. 1430  gosub 17000
  141. 1440  gshape(46,63),winner%():pena 19:? at(84,81);"YOU WIN THIS GAME"
  142. 1445  cx=1
  143. 1446  cy=5000
  144. 1447  n=sound(1,1,50,65,cy):n=sound(2,1,50,65,cy)
  145. 1448  sleep (10000)
  146. 1449  cy=cy-300:if cy>=100 then 1447
  147. 1450  cx=cx+1:if cx<=4 then 1446
  148. 1460  gosub 1470
  149. 1462  ask mouse x%,y%,b%:n=pixel(x%,y%)
  150. 1463  if b%=4 and (n=8 or n=19) then 1480
  151. 1467  sleep(30000):goto 1462
  152. 1470  pena 29
  153. 1471  ? at(7*8,175);inverse(1) "===== RUNNING TOTAL =====";inverse(0) " "
  154. 1472  ? at(2*8,183);inverse(1) "COMPUTER";inverse(0) " =";me;"GAMES   ";inverse(1) "YOU";inverse(0) " =";you;"GAMES"
  155. 1473  gosub 12000:return
  156. 1480  if n=19 then scnclr:end
  157. 1482  gosub 32200:gosub 12000:goto 300
  158. 1490  y5=0:m5=0:c=0:s9=0:g=0:right=5
  159. 1500  if m=0 then 1910
  160. 1510  if y5<>4 then 1540
  161. 1520  if m5=4 then 2470
  162. 1530  goto 1910
  163. 1540  gosub 17000:pena humcolor:msg$="Your play. Select a card.":gosub 7010
  164. 1550  gosub 25000:gosub 17000
  165. 1560  if c$<>"GO" then 1680
  166. 1570  x=31-s9
  167. 1575  n=1
  168. 1578  if y(n,5)=0 then 1590
  169. 1580  if y(n,4)<=x then 1600
  170. 1590  n=n+1:if n<7 then 1578
  171. 1595  goto 1910
  172. 1600  gosub 17000:msg$="SHAME ! SHAME !  You have a play !!!":pena 3:gosub 7010:gosub 8010:goto 1540
  173. 1680  c6=val(c$):if s9+y(c6,2)>31 then 1890
  174. 1690  s9=s9+y(c6,2):y5=y5+1:i(10+y5)=c6:c=c+1:right=right-1:j(c)=y(c6,4):mg$="You ":cx=humcolor:gosub 2960:gosub 6390
  175. 1700  if x31=1 then msg$="You get  2  points for 31":pena humcolor:gosub 7010
  176. 1750  y(c6,5)=0:cnt2=17:gosub 22000
  177. 1752  if y5=1 or cx1=164 then cx1=164:cy1=108:cx=cx1:cy=cy1:num=y(c6,4):suit=y(c6,3):gosub 21000:cx1=cx1+20:goto 1754
  178. 1753  zz=0:cx=cx1:cy=cy1:num=y(c6,4):suit=y(c6,3):gosub 21100:cx1=cx1+20
  179. 1754  r=p:if r<>0 then gosub 9040
  180. 1755  cx=8:cy=119:for n=1 to 6
  181. 1756  if y(n,5)=0 then 1759
  182. 1757  num=y(n,4):suit=y(n,3):gosub 21000
  183. 1758  cx=cx+35
  184. 1759  next n
  185. 1780  f=1
  186. 1820  if s9<>31 then 1910
  187. 1830  gosub 24000:cx1=164:cx2=164:f=0:c=0:s9=0:g=0:gosub 6390:goto 1910
  188. 1890  gosub 17000:msg$="That totals more than 31, TRY AGAIN!":pena 3:gosub 7010
  189. 1900  gosub 8010:goto 1540
  190. 1910  if m5<>4 then 2050
  191. 1920  if y5=4 then 2470
  192. 1930  if c$<>"GO" then 1510
  193. 1935  cx1=164:cx2=164
  194. 1940  if f=2 then 2000
  195. 1950  gosub 17000:pena humcolor:msg$="You get 1 point for last card.":gosub 7010
  196. 1960  r=1:gosub 9040:gosub 24000
  197. 1980  f=0:c=0:s9=0:gosub 6390
  198. 1990  goto 1510
  199. 2000  gosub 17000:pena compcolor:msg$="I get 1 point for last card.":gosub 7010
  200. 2010  r=1:gosub 9010:gosub 24000
  201. 2030  f=0:c=0:s9=0:gosub 6390
  202. 2040  goto 1510
  203. 2050  k9=0:p9=0:c9=c:c=c+1:h9=s9
  204. 2090  for i9=1 to 6
  205. 2100  i(i9)=0
  206. 2110  if i9=i1 then 2250
  207. 2120  if i9=i2 then 2250
  208. 2130  if m5=0 then 2170
  209. 2140  for j9=1 to m5
  210. 2150  if i9=i(20+j9) then n=1:j9=m5
  211. 2160  next j9:if n=1 then n=0:goto 2250
  212. 2170  if h9+m(i9,2)>31 then 2250
  213. 2180  k9=k9+1:s9=h9+m(i9,2):j(c)=m(i9,4):mg$="no":pena compcolor:gosub 2960
  214. 2220  if p>p9 then p9=p
  215. 2230  i(i9)=p:i(k9+30)=i9
  216. 2250  next i9
  217. 2260  c=c9:s9=h9
  218. 2280  if k9<>0 then 2570
  219. 2290  if c$<>"GO" then 2360
  220. 2300  if g=1 then 2370
  221. 2310  gosub 17000:pena compcolor:msg$="I get 1 point for last card.":gosub 7010
  222. 2320  c=0:s9=0:r=1:gosub 9010:gosub 24000:gosub 6390:cx1=164:cx2=164
  223. 2350  goto 1510
  224. 2360  if y5<>4 then 2430
  225. 2370  gosub 17000:pena humcolor:msg$="I'll give you 1 point for last card.":gosub 7010
  226. 2380  r=1:gosub 9040:gosub 24000:cx1=164:cx2=164
  227. 2400  c=0:s9=0:g=0:gosub 6390:c$="":goto 1910
  228. 2430  if g=1 then 1510
  229. 2440  gosub 17000:msg$="GO":pena 29:gosub 7010:g=1
  230. 2460  gosub 8010:goto 1510
  231. 2470  if f=0 then 2560
  232. 2475  cx1=164:cx2=164
  233. 2480  if f=1 then 2530
  234. 2490  gosub 17000:pena compcolor:msg$="I get 1 point for last card.":gosub 7010
  235. 2500  r=1:gosub 9010:gosub 24000:s9=0:gosub 6390
  236. 2520  goto 2560
  237. 2530  gosub 17000:pena humcolor:msg$="You get 1 point for last card.":gosub 7010
  238. 2540  r=1:gosub 9040:gosub 24000:s9=0:gosub 6390
  239. 2560  return
  240. 2570  c=c+1:m5=m5+1
  241. 2590  if c<>1 then 2740
  242. 2600  j7=1
  243. 2610  i9=v(b9,j7)
  244. 2620  vv=1
  245. 2630  if i(vv+20)=i9 then 2710 
  246. 2635  vv=vv+1:if vv<=m5+1 then 2630
  247. 2650  if m(i9,2)=5 then 2710
  248. 2660  i(m5+20)=i9:j(c)=m(i9,4):p9=0:s9=m(i9,2):goto 2810
  249. 2710  j7=j7+1:if j7<5 then 2610
  250. 2720  l=v(b9,1)
  251. 2730  goto 2660
  252. 2740  j8=1
  253. 2750  i9=i(j8+30)
  254. 2760  if i(i9)=p9 then 2780
  255. 2770  j8=j8+1:if j8<=k9 then 2750
  256. 2780  i(m5+20)=i9:j(c)=m(i9,4):s9=s9+m(i9,2)
  257. 2810  gosub 17000:msg$="MY PLAY":pena compcolor:gosub 7010:gosub 8010
  258. 2820  gosub 23000:cnt=cnt-1:gosub 32600
  259. 2822  if m5=1 or cx2=164 then cx2=164:cy2=63:cx=cx2:cy=cy2:num=m(i9,4):suit=m(i9,3):gosub 21000:cx2=cx2+20:goto 2840
  260. 2823  cx=cx2:cy=cy2:num=m(i9,4):suit=m(i9,3):gosub 21100:cx2=cx2+20
  261. 2840  f=2:gosub 6390:gosub 17000:mg$="I ":cx=compcolor:gosub 2960:r=p
  262. 2850  if s9=31 then gosub 17000:msg$="I get  2  points for 31 !":pena compcolor:gosub 7010
  263. 2860  if r<>0 then gosub 9010
  264. 2870  if s9<>31 then 2900
  265. 2880  gosub 24000:cx1=164:cx2=164:f=0:c=0:s9=0:gosub 6390:goto 1510
  266. 2900  if c$="GO" then 1910
  267. 2910  goto 1510
  268. 2960  p=0:x31=0
  269. 2970  if c=1 then 3200
  270. 2980  if s9<>15 then 3010
  271. 2990  p=p+2:if mg$<>"no" then msg$=mg$+"get 2 points for FIFTEEN.":gosub 17000:pena cx:gosub 7010:gosub 8010
  272. 3000  goto 3030
  273. 3010  if s9<>31 then 3030
  274. 3020  p=p+2:x31=1
  275. 3030  if c-2>2 then n=c-2:goto 3040
  276. 3035  n=2
  277. 3040  j=0:for i=c to n step -1
  278. 3050  if j(i)<>j(i-1) then if mg$<>"no" then 3125 else goto 3140
  279. 3060  on c-i+1 goto 3070,3090,3110
  280. 3070  p=p+2:j=1
  281. 3080  goto 3120
  282. 3090  p=p+4:j=2
  283. 3100  goto 3120
  284. 3110  p=p+6:j=3
  285. 3120  next i
  286. 3122  if mg$="no" then 3140
  287. 3125  if j=1 then msg$=mg$+"get 2 points for a PAIR."
  288. 3130  if j=2 then msg$=mg$+"get 6 points for THREE of a KIND."
  289. 3135  if j=3 then msg$=mg$+"get 12 points for FOUR of a KIND."
  290. 3137  if j<>0 then gosub 17000:pena cx:gosub 7010:gosub 8010
  291. 3140  if c=2 then 3200
  292. 3150  r9=0
  293. 3160  i=3
  294. 3162  gosub 3210
  295. 3164  i=i+1:if i<=c then 3162
  296. 3190  p=p+r9
  297. 3195  if r9<>0 then if mg$<>"no" then msg$=mg$+"get "+str$(r9)+" points for a "+str$(r9)+" card RUN.":gosub 17000:pena cx:gosub 7010
  298. 3200  return
  299. 3210  j=11
  300. 3212  j(j)=14
  301. 3214  j=j+1:if j<=20 then 3212
  302. 3220  j=1
  303. 3222  j(j+10)=j(c-j+1)
  304. 3224  j=j+1:if j<=c then 3222
  305. 3240  k=1
  306. 3250  l=k+1
  307. 3260  if j(k+10)<j(l+10) then 3300
  308. 3270  x=j(k+10):j(k+10)=j(l+10):j(l+10)=x
  309. 3300  l=l+1:if l<=i then 3260
  310. 3310  k=k+1:if k<=i-1 then 3250
  311. 3320  k=1
  312. 3330  if j(k+10)<>j(k+11)-1 then 3360
  313. 3340  k=k+1:if k<=i-1 then 3330
  314. 3350  r9=i
  315. 3360  return
  316. 3400  p9=0
  317. 3410  n=1:z9=1
  318. 3420  i1=v(z9,1):i2=v(z9,2):i3=v(z9,3):i4=v(z9,4)
  319. 3430  gosub 13000
  320. 3460  q1=0:j=1
  321. 3470  w(1,j)=m(i1,j)
  322. 3480  w(2,j)=m(i2,j)
  323. 3490  w(3,j)=m(i3,j)
  324. 3500  w(4,j)=m(i4,j)
  325. 3510  w(5,j)=25
  326. 3520  j=j+1:if j<5 then 3470
  327. 3540  c=0
  328. 3550  gosub 4390
  329. 3560  v(z9,7)=p
  330. 3570  if p>p9 then p9=p
  331. 3580  z9=z9+1:if z9<16 then 3420
  332. 3600  j=0
  333. 3610  i=1
  334. 3620  if v(i,7)<>p9 then 3650
  335. 3630  j=j+1:i(j)=i
  336. 3650  i=i+1:if i<16 then 3620
  337. 3660  if j>1 then 3720
  338. 3680  b9=i(1)
  339. 3690  gosub 14000:return
  340. 3720  c9=5:z=1:goto 3960
  341. 3760  n=1:c9=8:z=2:goto 3960
  342. 3800  c9=7:z=3:goto 3960
  343. 3840  c9=11:z=4:goto 3960
  344. 3880  c9=1:z=5:goto 3960
  345. 3920  b9=int(j*rnd)+1
  346. 3930  b9=i(b9):gosub 14000:return
  347. 3960  p9=0
  348. 3965  gosub 13000
  349. 3970  i=1
  350. 3972  j(i)=0
  351. 3974  i=i+1:if i<16 then 3972
  352. 4000  i=1
  353. 4010  k=1
  354. 4020  l=v(i(i),k)
  355. 4030  if m(l,4)<>c9 goto 4050
  356. 4040  j(i)=j(i)+1
  357. 4050  k=k+1:if k<5 then 4020
  358. 4060  if j(i)>p9 then p9=j(i)
  359. 4070  i=i+1:if i<=j then 4010
  360. 4080  k=0
  361. 4090  i=1
  362. 4100  if j(i)<>p9 then 4130
  363. 4110  k=k+1:b9=i(i)
  364. 4130  i=i+1:if i<=j then 4100
  365. 4140  if k<>1 then 4160
  366. 4150  gosub 14000:return
  367. 4160  on z goto 3760,3800,3840,3880,3920
  368. 4200  n=int(rnd*38)+14
  369. 4210  gosub 17000:msg$="THE UPCARD IS....":pena 29:gosub 7010
  370. 4220  cx=9:cy=63:num=d(n,4):suit=d(n,3):gosub 21000:q1=0:gosub 8010
  371. 4240  i=1
  372. 4242  w(5,i)=d(n,i)
  373. 4244  i=i+1:if i<5 then 4242
  374. 4270  t9=w(5,4)
  375. 4280  if w(5,4)<>11 then 4370
  376. 4290  if m=0 then 4340
  377. 4300  gosub 17000:msg$="TWO POINTS TO ME.":pena compcolor:gosub 7010
  378. 4310  r=2:gosub 9010
  379. 4330  return
  380. 4340  gosub 17000:msg$="TWO POINTS TO YOU.":pena humcolor:gosub 7010
  381. 4350  r=2:gosub 9040
  382. 4370  return
  383. 4390  rem
  384. 4420  p=0
  385. 4430  rem
  386. 4440  i=1
  387. 4450  if w(i,4)<>11 goto 4490
  388. 4460  if w(i,3)<>w(5,3) goto 4490
  389. 4470  p=p+1
  390. 4480  goto 4500
  391. 4490  i=i+1:if i<5 then 4450
  392. 4500  rem
  393. 4510  i=1
  394. 4520  if w(i,3)<>w(i+1,3) goto 4620
  395. 4530  i=i+1:if i<4 then 4520
  396. 4540  rem
  397. 4550  if c<>0 goto 4600
  398. 4560  p=p+4
  399. 4570  if w(4,3)<>w(5,3) goto 4620
  400. 4580  p=p+1
  401. 4590  goto 4620
  402. 4600  if w(4,3)<>w(5,3) goto 4620
  403. 4610  p=p+5
  404. 4620  rem
  405. 4630  i=1
  406. 4640  j=i+1
  407. 4650  if w(i,2)+w(j,2)<>15 goto 4670
  408. 4660  p=p+2
  409. 4670  j=j+1:if j<6 then 4650
  410. 4680  i=i+1:if i<5 then 4640
  411. 4690  rem
  412. 4700  i=1
  413. 4710  j=i+1
  414. 4720  k=j+1
  415. 4730  if w(i,2)+w(j,2)+w(k,2)<>15 goto 4750
  416. 4740  p=p+2
  417. 4750  k=k+1:if k<6 then 4730
  418. 4760  j=j+1:if j<5 then 4720
  419. 4770  i=i+1:if i<4 then 4710
  420. 4780  rem
  421. 4790  i=1
  422. 4800  j=i+1
  423. 4810  k=j+1
  424. 4820  l=k+1
  425. 4830  if (w(i,2)+w(j,2)+w(k,2)+w(l,2))<>15 goto 4850
  426. 4840  p=p+2
  427. 4850  l=l+1:if l<6 then 4830
  428. 4860  k=k+1:if k<5 then 4820
  429. 4870  j=j+1:if j<4 then 4810
  430. 4880  i=i+1:if i<3 then 4800
  431. 4890  rem
  432. 4900  s=0
  433. 4910  i=1
  434. 4920  s=s+w(i,2)
  435. 4930  i=i+1:if i<6 then 4920
  436. 4940  if s<>15 goto 4960
  437. 4950  p=p+2
  438. 4960  rem
  439. 4970  i=1
  440. 4980  j(i)=0
  441. 4990  i=i+1:if i<14 then 4980
  442. 5000  i=1
  443. 5010  j=w(i,4)
  444. 5020  j(j)=j(j)+1
  445. 5030  i=i+1:if i<6 then 5010
  446. 5040  i=1
  447. 5050  on j(i)+1 goto 5090,5090,5080,5070,5060
  448. 5060  p=p+6
  449. 5070  p=p+4
  450. 5080  p=p+2
  451. 5090  i=i+1:if i<14 then 5050
  452. 5100  rem
  453. 5110  for i=1 to 5
  454. 5120  for j=i to 5
  455. 5130  if w(i,4)<=w(j,4) goto 5150
  456. 5140  swap w(i,4),w(j,4)
  457. 5150  next j
  458. 5160  next i
  459. 5170  rem
  460. 5180  d=w(1,4)-q(1,1)
  461. 5190  i=1
  462. 5200  j=1
  463. 5210  q(i,j)=q(i,j)+d
  464. 5220  j=j+1:if j<6 then 5210
  465. 5230  i=i+1:if i<12 then 5200
  466. 5240  i=1
  467. 5250  j=1
  468. 5260  if w(j,4)<>q(i,j) goto 5310
  469. 5270  j=j+1:if j<6 then 5260
  470. 5280  rem
  471. 5290  p=p+q(i,6)
  472. 5300  return
  473. 5310  i=i+1:if i<12 then 5250
  474. 5320  rem
  475. 5330  l=1
  476. 5340  d=w(l,4)-r(1,1)
  477. 5350  i=1
  478. 5360  j=1
  479. 5370  r(i,j)=r(i,j)+d
  480. 5380  j=j+1:if j<5 then 5370
  481. 5390  i=i+1:if i<5 then 5360
  482. 5400  i=1
  483. 5410  k=1
  484. 5420  if w(k+l-1,4)<>r(i,k) goto 5470
  485. 5430  k=k+1:if k<5 then 5420
  486. 5440  rem
  487. 5450  p=p+r(i,5)
  488. 5460  return
  489. 5470  i=i+1:if i<5 then 5410
  490. 5480  l=l+1:if l<3 then 5340
  491. 5490  rem
  492. 5500  l=1
  493. 5510  d=w(l,4)-s(1)
  494. 5520  i=1
  495. 5530  s(i)=s(i)+d
  496. 5540  i=i+1:if i<4 then 5530
  497. 5550  i=1
  498. 5560  if w(l+i-1,4)<>s(i) goto 5610
  499. 5570  i=i+1:if i<4 then 5560
  500. 5580  rem
  501. 5590  p=p+s(4)
  502. 5600  return
  503. 5610  l=l+1:if l<4 then 5510
  504. 5620  return
  505. 5660  gosub 17000:msg$="SHUFFLING":pena 25:gosub 7010
  506. 5665  randomize -1
  507. 5670  for j=0 to 51:i(j)=j:next j
  508. 5690  for j=51 to 1 step -1
  509. 5700  k=int(rnd*(j+1))
  510. 5710  swap i(j),i(k)
  511. 5720  next j
  512. 5730  i=1
  513. 5740  j=i(i-1)+1
  514. 5750  d(i,1)=j
  515. 5755  d(i,3)=int((j-1)/13)+1
  516. 5760  d(i,4)=j-13*int((j-1)/13)
  517. 5765  if d(i,4)<10 then d(i,2)=d(i,4):goto 5775
  518. 5770  d(i,2)=10
  519. 5775  i=i+1:if i<53 then 5740
  520. 5780  return
  521. 5820  gosub 17000:msg$="Press BUTTON to cut for deal.":pena 18:gosub 7010
  522. 5830  ask mouse x%,y%,b%:if b%<>4 then 5830
  523. 5880  randomize -1:i=int(rnd*52)+1
  524. 5890  gosub 17000:msg$="YOUR card is ........":pena humcolor:gosub 7010
  525. 5900  cx=43:cy=119:num=d(i,4):suit=d(i,3):gosub 21000:gosub 8010
  526. 5910  randomize -1:j=int(rnd*52)+1
  527. 5920  if j=i then 5910
  528. 5930  gosub 17000:msg$="MY card is ..........":pena compcolor:gosub 7010
  529. 5940  cx=113:cy=119:num=d(j,4):suit=d(j,3):gosub 21000:gosub 8010
  530. 5950  if d(i,4)<d(j,4) then m=1:gosub 17000:msg$="YOUR CRIB......":pena humcolor:gosub 7010:gosub 8010:goto 6000
  531. 5960  if d(j,4)<d(i,4) then m=0:gosub 17000:msg$="MY CRIB........":pena 0:gosub 7010:gosub 8010:goto 6000
  532. 5970  gosub 17000:msg$="please cut again":pena 29:gosub 7010:gosub 8010:cnt2=19:gosub 22000:goto 5820
  533. 6000  cnt2=19:gosub 22000:return
  534. 6100  r=0:s9=0:gosub 6390
  535. 6110  if m=0 then gshape(50,100),mycrib%():goto 6120
  536. 6115  gshape(50,100),yourcrib%()
  537. 6120  m=1-m:y=1-m
  538. 6150  gosub 17000:msg$=" - - YOUR CARDS ARE - -":pena humcolor:gosub 7010
  539. 6160  cx=8:cy=119:cxx=269:cyy=63
  540. 6170  n=1
  541. 6180  k=2*n-y:l=2*n-m
  542. 6200  i=1
  543. 6240  m(n,i)=d(k,i):y(n,i)=d(l,i):y(n,5)=1
  544. 6250  i=i+1:if i<5 then 6240
  545. 6255  n=n+1:if n<7 then 6180
  546. 6265  k=1
  547. 6266  l=k+1
  548. 6267  if y(k,4)>y(l,4) then 6271
  549. 6268  i=1
  550. 6269  x=y(k,i):y(k,i)=y(l,i):y(l,i)=x
  551. 6270  i=i+1:if i<5 then 6269
  552. 6271  l=l+1:if l<7 then 6267
  553. 6273  k=k+1:if k<6 then 6266
  554. 6275  cnt=1
  555. 6284  for n=1 to 6:if m=1 then if cnt=1 then gosub 32605 else gosub 32625
  556. 6285  num=y(n,4):suit=y(n,3):gosub 21000:cx=cx+35:if m=0 then if cnt=1 then gosub 32605 else gosub 32625
  557. 6286  cnt=2:next n
  558. 6288  gosub 17000:pena 25:? at(8*2,175);inverse(1) "=STUDY YOUR HAND=":? at(20*8,175);" while I'm gone":cnt=6
  559. 6289  return
  560. 6390  drawmode 1:pena 6:penb 7:locate(84,83):print using "##";s9:drawmode 0
  561. 6395  return
  562. 7010  msg=int(len(msg$)/2)
  563. 7015  print at(8*(19-msg),175);msg$
  564. 7030  return
  565. 8010  sleep(1.5*10^6)
  566. 8030  return
  567. 9010  mpeg=3-mpeg:q1=0:q2=s1
  568. 9011  if mpeg=1 and q4<>0 then gshape(mp1x,mp1y),computerb%()
  569. 9012  if mpeg=1 then mp1x=mp2x:mp1y=mp2y
  570. 9013  if mpeg=2 then gshape(mp2x,mp2y),computerb%():mp2x=mp1x:mp2y=mp1y
  571. 9014  for peg=s1+1 to s1+r
  572. 9015  on mpeg gosub 9020,9025:pena 8:penb 21:drawmode 1:locate (37,33):print using "###";peg:drawmode 0
  573. 9016  x%=sound(1,1,2,60,7000):x%=sound(2,1,2,60,7000):sleep(200000)
  574. 9019  next peg:s1=s1+r:q4=1:gosub 8010:return
  575. 9020  xx=mp1x:yy=mp1y:gosub 9030:mp1x=xx+pegpos(peg):mp1y=yy:return
  576. 9025  xx=mp2x:yy=mp2y:gosub 9030:mp2x=xx+pegpos(peg):mp2y=yy:return
  577. 9030  if peg=121 then gshape(xx,yy),computerb%():gshape(11,yy),computer%():me=me+1:goto 1400
  578. 9032  if peg=31 or peg=91 then yy=yy+8:if q2<>30 and q2<>90 then gshape(xx,yy-8),computerb%()
  579. 9033  if peg=61 then yy=yy-8:if q2<>60 then gshape(xx,yy+8),computerb%()
  580. 9034  if q1<>0 then gshape(xx,yy),computerb%()
  581. 9035  q1=1:gshape(xx+pegpos(peg),yy),computer%():return
  582. 9040  ypeg=3-ypeg:q1=0:q2=s2
  583. 9041  if ypeg=1 and q5<>0 then gshape(yp1x,yp1y),humanb%()
  584. 9042  if ypeg=1 then yp1x=yp2x:yp1y=yp2y
  585. 9043  if ypeg=2 then gshape(yp2x,yp2y),humanb%():yp2x=yp1x:yp2y=yp1y
  586. 9044  for peg=s2+1 to s2+r
  587. 9045  on ypeg gosub 9050,9055:pena 19:penb 21:drawmode 1:locate (255,33):print using "###";peg:drawmode 0
  588. 9046  x%=sound(1,1,2,60,2000):x%=sound(2,1,2,60,2000):sleep(200000)
  589. 9049  next peg:s2=s2+r:q5=1:gosub 8010:return
  590. 9050  xx=yp1x:yy=yp1y:gosub 9060:yp1x=xx+pegpos(peg):yp1y=yy:return
  591. 9055  xx=yp2x:yy=yp2y:gosub 9060:yp2x=xx+pegpos(peg):yp2y=yy:return
  592. 9060  if peg=121 then gshape(xx,yy),humanb%():gshape(11,yy),human%():you=you+1:goto 1430
  593. 9062  if peg=31 or peg=91 then yy=yy-8:if q2<>30 and q2<>90 then gshape(xx,yy+8),humanb%()
  594. 9063  if peg=61 then yy=yy+8:if q2<>60 then gshape(xx,yy-8),humanb%()
  595. 9064  if q1<>0 then gshape(xx,yy),humanb%()
  596. 9065  q1=1:gshape(xx+pegpos(peg),yy),human%():return
  597. 10000 data 1,2,3,4,5,6,0,1,2,3,5,4,6,0,1,2,3,6,4,5,0
  598. 10002 data 1,2,4,5,3,6,0,1,2,4,6,3,5,0,1,2,5,6,3,4,0
  599. 10004 data 1,3,4,5,2,6,0,1,3,4,6,2,5,0,1,3,5,6,2,4,0
  600. 10006 data 1,4,5,6,2,3,0,2,3,4,5,1,6,0,2,3,4,6,1,5,0
  601. 10008 data 2,3,5,6,1,4,0,2,4,5,6,1,3,0,3,4,5,6,1,2,0
  602. 10010 data 1,1,1,2,3,09,1,1,2,2,3,12,1,1,2,3,3,12
  603. 10012 data 1,1,2,3,4,08,1,2,2,2,3,09,1,2,2,3,3,12
  604. 10014 data 1,2,2,3,4,08,1,2,3,3,3,09,1,2,3,3,4,08
  605. 10016 data 1,2,3,4,4,08,1,2,3,4,5,05
  606. 10018 data 1,1,2,3,6,1,2,2,3,6,1,2,3,3,6,1,2,3,4,4
  607. 10020 data 1,2,3,3
  608. 10022 data 1,2,3,4,5,6
  609. 11000 rem
  610. 12000 mpeg=2:ypeg=2:mp1x=11:mp1y=9:mp2x=11:mp2y=9:yp1x=11:yp1y=45:yp2x=11:yp2y=45:q4=0:q5=0:return
  611. 13000 rgb 22,regsave%(n*3),regsave%(n*3+1),regsave%(n*3+2)
  612. 13010 n=n+2
  613. 13020 return
  614. 14000 rgb 22,regsave%(66),regsave%(67),regsave%(68)
  615. 14010 return
  616. 17000 drawmode 0:peno 19:pena 12:paint(2,184),0
  617. 17010 return
  618. 21000 for q=0 to 64 step 16:qq=sound(1,1,2,q,5000):qq=sound(2,1,2,q,4000):next q
  619. 21010 on suit gosub 21050,21060,21070,21080
  620. 21020 pena 18:? at(cx+4,cy+8);mid$(nl$,num,1):? at(cx+23,cy+38);mid$(nl$,num,1)
  621. 21040 return
  622. 21050 gshape(cx,cy),spades%():return
  623. 21060 gshape(cx,cy),clubs%():return
  624. 21070 gshape(cx,cy),hearts%():return
  625. 21080 gshape(cx,cy),diamonds%():return
  626. 21100 for q=0 to 64 step 16:qq=sound(1,1,2,q,5000):qq=sound(2,1,2,q,4000):next q
  627. 21110 on suit gosub 21150,21160,21170,21180
  628. 21120 pena 18:? at(cx+4,cy+8);mid$(nl$,num,1):? at(cx+23,cy+38);mid$(nl$,num,1)
  629. 21140 return
  630. 21150 gshape(cx,cy),spades2%():return
  631. 21160 gshape(cx,cy),clubs2%():return
  632. 21170 gshape(cx,cy),hearts2%():return
  633. 21180 gshape(cx,cy),diamonds2%():return
  634. 22000 for n=cnt2+1 to 1 step -1:gshape(n*8,119),carderase%():next n
  635. 22030 return
  636. 23000 for n=13 to 1 step -1:gshape(269,62+((n-1)*8)),backerase%():next n
  637. 23030 return
  638. 24000 for n=32 to 20 step -1:gshape(n*8,108),carderase%():next n
  639. 24020 for n=32 to 20 step -1:gshape(n*8,63),carderase%():next n
  640. 24030 return
  641. 25000 num=1:for n=1 to 6
  642. 25002 if y(n,5)=1 then card(num)=n:num=num+1
  643. 25004 next n
  644. 25005 if right<6 then gshape(8+(right*35),154),gobox%()
  645. 25007 gosub 26100:q1=0:q2=0
  646. 25010 ask mouse x%,y%,b%
  647. 25015 if b%=4 and right=6 then 25045
  648. 25020 if b%=4 and right<6 then 26000
  649. 25030 goto 25010
  650. 25045 if y%<119 or y%>160 then 25010
  651. 25050 i=1
  652. 25055 if x%>8+((i-1)*35) and x%<8+(((i-1)*35)+33) then 25070
  653. 25060 i=i+1:if i<=right then 25055
  654. 25065 goto 25010
  655. 25070 gshape(15+((i-1)*35),161),pointer%():gosub 26100
  656. 25075 if q1=0 then q1=card(i):goto 25010
  657. 25080 q2=card(i):if q1=q2 then q2=0:goto 25010
  658. 25085 return
  659. 26000 if y%>153 and y%<165 and x%>8+(right*35) and x%<8+((right*35)+22) then c$="GO":return
  660. 26010 if y%<119 or y%>160 then 25010
  661. 26020 i=1
  662. 26030 if x%>8+((i-1)*35) and x%<8+(((i-1)*35)+33) then 26060
  663. 26040 i=i+1:if i<=right-1 then 26030
  664. 26050 goto 25010
  665. 26060 c$=str$(card(i))
  666. 26070 gshape(8+(right*35),154),goboxb%():return
  667. 26100 rem sound
  668. 26150 return
  669. 27000 gshape(115,63),updown%():gshape(146,75),donebox%():drawmode 1:pena 6:penb 7:p9=0:n=0
  670. 27010 ask mouse x%,y%,b%:st=pixel(x%,y%)
  671. 27015 if b%=4 and x%>146 and x%<184 and y%>75 and y%<85 then n=1
  672. 27020 if n=1 then print at(84,83);" 0":drawmode 0:gshape(115,63),updownb%():gshape(146,75),doneboxb%():return
  673. 27022 if b%=0 goto 27010
  674. 27025 if st<>8 and st<>3 then 27010
  675. 27030 if st=8 then 27050
  676. 27035 if st=3 then 27060
  677. 27040 goto 27010
  678. 27050 p9=p9+1:if p9>29 then p9=0
  679. 27055 locate(84,83):print using "##";p9;
  680. 27058 sleep(.2*10^6):goto 27010
  681. 27060 p9=p9-1:if p9<0 then p9=29
  682. 27065 locate(84,83):print using "##";p9;
  683. 27068 sleep(.2*10^6):goto 27010
  684. 30000 restore 30080
  685. 30010 i=1
  686. 30012 read pegpos(i)
  687. 30014 i=i+1:if i<61 then 30012
  688. 30020 restore 30080
  689. 30030 i=61
  690. 30032 read pegpos(i)
  691. 30034 i=i+1:if i<121 then 30032
  692. 30040 pegpos(61)=0:return
  693. 30080 data 15,8,8,8,8,13,8,8,8,8,13,8,8,8,8,13,8,8,8,8,13,8,8,8,8,13,8,8,8,8,0,-8,-8,-8,-8,-13,-8,-8,-8,-8
  694. 30081 data -13,-8,-8,-8,-8,-13,-8,-8,-8,-8,-13,-8,-8,-8,-8,-13,-8,-8,-8,-8
  695. 32000 bload "clubs1",varptr(clubs%(0)):bload "spades1",varptr(spades%(0)):bload "hearts1",varptr(hearts%(0)):bload "cribscreen",varptr(cribscreen%(0))
  696. 32004 bload "back1",varptr(back1%(0)):bload "back2",varptr(back2%(0)):bload "player1",varptr(computer%(0)):bload "player2",varptr(human%(0))
  697. 32008 bload "blankplay1",varptr(computerb%(0)):bload "blankplay2",varptr(humanb%(0)):bload "mycrib",varptr(mycrib%(0))
  698. 32011 bload "yourcrib",varptr(yourcrib%(0)):bload "points",varptr(points%(0)):bload "pointer",varptr(pointer%(0))
  699. 32015 bload "updown",varptr(updown%(0)):bload "blankud",varptr(updownb%(0)):bload "gobox",varptr(gobox%(0)):bload "donebox",varptr(donebox%(0))
  700. 32019 bload "winner",varptr(winner%(0)):sshape(269,155;303,163),backerase%():sshape(219,119;227,165),carderase%():sshape(100,0;123,11),goboxb%()
  701. 32023 sshape(225,154;264,165),doneboxb%():bload "diamonds1",varptr(diamonds%(0)):bload "clubs2",varptr(clubs2%(0)):bload "spades2",varptr(spades2%(0))
  702. 32027 bload"hearts2",varptr(hearts2%(0)):bload "diamonds2",varptr(diamonds2%(0)):return
  703. 32200 gshape(0,0),cribscreen%():gshape(11,9),computer%():gshape(11,45),human%()
  704. 32210 return
  705. 32600 cxx=269:cyy=63:rem **** draw back of card ****
  706. 32605 if cnt=0 then return
  707. 32620 gosub 32700:if cnt=1 then return
  708. 32625 for q1=1 to cnt-1:cyy=cyy+11:gosub 32710:next q1:return
  709. 32700 gshape(cxx,cyy),back1%():return
  710. 32710 gshape(cxx,cyy),back2%():return
  711. 32720 rem
  712. 32721 cxx=9:cyy=63:gosub 32700
  713. 32730 pena 7:peno 29:paint(80,72),0
  714. 32740 return
  715.